unit dorm.adapter.UIB.BaseAdapter;

interface

uses
  dorm.Commons,
  dorm.Mappings,
  classes,
  SysUtils,
  DB,
  Rtti,
  dorm,
  superobject,
  TypInfo,
  FMTBcd,
  dorm.Filters,
  Generics.Collections,
  dorm.Collections,
  dorm.adapter.UIB.Facade,
  UIB,
  dorm.adapter.Base;

type
  TUIBBaseAdapter = class(TBaseAdapter, IdormPersistStrategy)
  strict protected
    FB: TUIBFacade;
    FLogger: IdormLogger;
    FCurTransaction: TUIBTransaction;
    FKeysGeneratorClassName: string;
    FKeysGenerator: IdormKeysGenerator;
    FKeyType: TdormKeyType;
    FNullKeyValue: TValue;
    FLastInsertOID: TValue;
    function CreateUIBFacade(Conf: ISuperObject): TUIBFacade; virtual; abstract;
    function CreateObjectFromUIBQuery(ARttiType: TRttiType;
      AReader: TUIBQuery; AFieldsMapping: TMappingFieldList): TObject;
    function LoadObjectFromDBXReader(ARttiType: TRttiType; AReader: TUIBQuery;
      AFieldsMapping: TMappingFieldList; AObject: TObject): Boolean;
    function GetLogger: IdormLogger;
    procedure SetUIBParameterValue(AFieldType: string;
      AStatement: TUIBStatement; ParameterIndex: Integer; AValue: TValue);
  public
    function GenerateAndFillPrimaryKeyParam(Query: TUIBStatement;
      ParamIndex: Integer; const Entity: string): TValue; overload;
    function FillPrimaryKeyParam(Query: TUIBStatement; ParamIndex: Integer;
      const Value: TValue): TValue;
    function GetLastInsertOID: TValue;
    function GetKeysGenerator: IdormKeysGenerator;
    function Insert(ARttiType: TRttiType; AObject: TObject; ATableName: string;
      AFieldsMapping: TMappingFieldList): TValue;
    function Update(ARttiType: TRttiType; AObject: TObject; ATableName: string;
      AFieldsMapping: TMappingFieldList): TValue;
    function Load(ARttiType: TRttiType; ATableName: string;
      AFieldsMapping: TMappingFieldList; const Value: TValue)
      : TObject; overload;

    function List(ARttiType: TRttiType; ATableName: string;
      AFieldsMapping: TMappingFieldList;
      AdormSearchCriteria: IdormSearchCriteria): TObjectList<TObject>;
    procedure FillList(AList: TObject; ARttiType: TRttiType;
      ATableName: string; AFieldsMapping: TMappingFieldList;
      AdormSearchCriteria: IdormSearchCriteria);

    function Delete(ARttiType: TRttiType; AObject: TObject; ATableName: string;
      AFieldsMapping: TMappingFieldList): TObject;
    procedure DeleteAll(ATableName: string);
    function Count(ATableName: string): Int64;
    procedure ConfigureStrategy(ConfigurationInfo: ISuperObject); virtual;
    procedure InitStrategy;
    procedure StartTransaction;
    procedure Commit;
    procedure Rollback;
    function InTransaction: Boolean;
    procedure SetLogger(ALogger: IdormLogger);
    destructor Destroy; override;
    class procedure register;
    function IsNullKey(const Value: TValue): Boolean;
    function GetNullKeyValue: TValue;
    function GetKeyType: TdormKeyType;
    function RawExecute(SQL: string): Int64;
    function ExecuteAndGetFirst(SQL: string): Int64;
    // function GetSelectSQL(Criteria: TdormCriteria;
    // AMappingTable: TMappingTable): string;
  end;

  TUIBBaseTableSequence = class(TdormInterfacedObject, IdormKeysGenerator)
  private
    FPersistStrategy: IdormPersistStrategy;
  public
    function NewStringKey(const Entity: string): string;
    function NewIntegerKey(const Entity: string): UInt64;
    procedure SetPersistStrategy(const PersistentStrategy
      : IdormPersistStrategy);
    // class procedure RegisterClass;
  end;

implementation

uses
  dorm.Utils;

function TUIBBaseAdapter.Update(ARttiType: TRttiType; AObject: TObject;
  ATableName: string; AFieldsMapping: TMappingFieldList): TValue;
var
  field: TMappingField;
  SQL: string;
  Query: TUIBStatement;
  I, pk_idx: Integer;
  v: TValue;
  sql_fields_names: string;
  pk_field: string;
  _table: TMappingTable;
begin
  sql_fields_names := '';
  for field in AFieldsMapping do
    if not field.IsPK then
      sql_fields_names := sql_fields_names + ',"' + field.FieldName + '" = ?';
  System.Delete(sql_fields_names, 1, 1);

  pk_field := AFieldsMapping[GetPKMappingIndex(AFieldsMapping)].FieldName;
  SQL := Format('UPDATE %S SET %S WHERE %S = ?', [ATableName, sql_fields_names,
    pk_field]);

  GetLogger.Debug(AFieldsMapping[GetPKMappingIndex(AFieldsMapping)].FieldName);

  GetLogger.Debug('PREPARING: ' + SQL);
  Query := FB.Prepare(SQL);
  try
    I := 0;
    for field in AFieldsMapping do
    begin
      v := TdormUtils.GetField(AObject, field.name);
      if field.IsPK then
        Continue
      else
      begin
        SetUIBParameterValue(field.FieldType, Query, I, v);
      end;
      inc(I);
    end;
    pk_idx := GetPKMappingIndex(AFieldsMapping);

    v := ARttiType.GetProperty(AFieldsMapping[pk_idx].name).GetValue(AObject);
    FillPrimaryKeyParam(Query, I, v);
    GetLogger.Debug('EXECUTING PREPARED: ' + SQL);
    FB.Execute(Query);
  finally
    Query.Free;
  end;
end;

procedure TUIBBaseAdapter.Commit;
begin
  FB.CommitTransaction;
end;

procedure TUIBBaseAdapter.ConfigureStrategy(ConfigurationInfo
  : ISuperObject);
var
  ctx: TRttiContext;
  t: TRttiType;
  obj: TObject;
begin
  FB := CreateUIBFacade(ConfigurationInfo);
  FKeysGeneratorClassName := ConfigurationInfo.S['keys_generator'];
  t := ctx.FindType(FKeysGeneratorClassName);
  if t = nil then
    raise EdormException.Create('Unknown key generator ' +
      FKeysGeneratorClassName);
  obj := t.AsInstance.MetaclassType.Create;
  if not Supports(obj, IdormKeysGenerator, FKeysGenerator) then
    raise EdormException.Create('Keys generator ' + FKeysGeneratorClassName +
      ' doesn''t implements ''IdormKeysGenerator''');
  FKeysGenerator.SetPersistStrategy(self);
  self._Release;

  if (SameText(ConfigurationInfo.S['key_type'], 'integer')) then
  begin
    FKeyType := ktInteger;
    FNullKeyValue := ConfigurationInfo.I['null_key_value']
  end
  else if (SameText(ConfigurationInfo.S['key_type'], 'string')) then
  begin
    FKeyType := ktString;
    FNullKeyValue := ConfigurationInfo.S['null_key_value']
  end
  else
    raise EdormException.Create('Unknown key type');
  inherited;
end;

function TUIBBaseAdapter.Count(ATableName: string): Int64;
var
  cmd: TUIBQuery;
  SQL: string;
begin
  Result := -1;
  SQL := 'SELECT COUNT(*) FROM ' + ATableName;
  GetLogger.Debug('PREPARING: ' + SQL);
  cmd := FB.Prepare(SQL);
  try
    cmd.Open;
    if not cmd.Eof then
      Result := cmd.Fields.AsInt64[0];
  finally
    cmd.Free;
  end;
end;

function TUIBBaseAdapter.Delete(ARttiType: TRttiType; AObject: TObject;
  ATableName: string; AFieldsMapping: TMappingFieldList): TObject;
var
  pk_idx: Integer;
  pk_value: TValue;
  pk_attribute_name, pk_field_name, SQL: string;
  cmd: TUIBStatement;
begin
  pk_idx := GetPKMappingIndex(AFieldsMapping);
  if pk_idx = -1 then
    raise Exception.Create('Invalid primary key for table ' + ATableName);
  pk_attribute_name := AFieldsMapping[pk_idx].name;
  pk_field_name := AFieldsMapping[pk_idx].FieldName;
  pk_value := ARttiType.GetProperty(pk_attribute_name).GetValue(AObject);
  SQL := 'DELETE FROM ' + ATableName + ' WHERE ' + pk_field_name + ' = ?';
  GetLogger.Debug('PREPARING: ' + SQL);
  cmd := FB.Prepare(SQL);
  try
    FillPrimaryKeyParam(cmd, pk_idx, pk_value);
    GetLogger.Debug('EXECUTING PREPARED: ' + SQL);
    cmd.Execute;
  finally
    cmd.Free;
  end;
  Result := nil;
end;

procedure TUIBBaseAdapter.DeleteAll(ATableName: string);
var
  SQL: string;
begin
  SQL := 'DELETE FROM ' + ATableName;
  GetLogger.Debug('EXECUTING :' + SQL);
  FB.Execute(SQL);
end;

destructor TUIBBaseAdapter.Destroy;
begin
  FB.Free;
  inherited;
end;

function TUIBBaseAdapter.ExecuteAndGetFirst(SQL: string): Int64;
var
  cmd: TUIBQuery;
begin
  Result := 0;
  cmd := FB.Prepare(SQL);
  try
    cmd.Open;
    if not cmd.Eof then
      Result := Int64(cmd.Fields.AsInt64[0])
    else
      raise EdormException.Create('ExecuteAndGetFirst returns o rows');
  finally
    cmd.Free;
  end;
end;

function TUIBBaseAdapter.GenerateAndFillPrimaryKeyParam
  (Query: TUIBStatement; ParamIndex: Integer; const Entity: string): TValue;
var
  Value: TValue;
begin
  case FKeyType of
    ktString:
      begin
        Value := FKeysGenerator.NewStringKey(Entity);
      end;
    ktInteger:
      begin
        Value := Int64(FKeysGenerator.NewIntegerKey(Entity));
      end;
  end;
  // Assert(Value.IsType<Int64>());
  Result := FillPrimaryKeyParam(Query, ParamIndex, Value);
  FLastInsertOID := Result;
end;

function TUIBBaseAdapter.FillPrimaryKeyParam(Query: TUIBStatement;
  ParamIndex: Integer;
  const Value: TValue): TValue;
begin
  try
    case FKeyType of
      ktString:
        begin
          Query.Params.AsString[ParamIndex] := Value.AsString;
          Result := Query.Params.AsString[ParamIndex];
        end;
      ktInteger:
        begin
          Query.Params.AsInt64[ParamIndex] := Value.AsInteger;
          Result := Query.Params.AsInt64[ParamIndex];
        end;
    end;
  except
    on E: Exception do
      raise EdormException.Create('Error during fill primary key for query. ' +
        E.Message);
  end;
end;

function TUIBBaseAdapter.GetKeysGenerator: IdormKeysGenerator;
begin
  Result := FKeysGenerator;
end;

function TUIBBaseAdapter.GetKeyType: TdormKeyType;
begin
  Result := FKeyType;
end;

function TUIBBaseAdapter.GetLastInsertOID: TValue;
begin
  Result := FLastInsertOID;
end;

function TUIBBaseAdapter.GetLogger: IdormLogger;
begin
  Result := FLogger;
end;

procedure TUIBBaseAdapter.InitStrategy;
begin
  FLastInsertOID := TValue.Empty;
end;

function TUIBBaseAdapter.Insert(ARttiType: TRttiType; AObject: TObject;
  ATableName: string; AFieldsMapping: TMappingFieldList): TValue;
var
  field: TMappingField;
  sql_fields_names, sql_fields_values, SQL: ansistring;
  Query: TUIBStatement;
  I, pk_idx: Integer;
  v, pk_value: TValue;
begin
  sql_fields_names := '';
  for field in AFieldsMapping do
  begin {todo: manage transients fields}
    sql_fields_names := sql_fields_names + ',"' +
      ansistring(field.FieldName) + '"';
  end;

  System.Delete(sql_fields_names, 1, 1);

  sql_fields_values := '';
  for field in AFieldsMapping do
    sql_fields_values := sql_fields_values + ',?';
  System.Delete(sql_fields_values, 1, 1);

  SQL := Format('INSERT INTO %s (%S) VALUES (%S)',
    [ATableName, sql_fields_names, sql_fields_values]);
  GetLogger.Debug('PREPARING :' + string(SQL));
  Query := FB.Prepare(string(SQL));
  try
    I := 0;
    for field in AFieldsMapping do
    begin
      v := TdormUtils.GetField(AObject, field.name);
      if field.IsPK then
        pk_value := GenerateAndFillPrimaryKeyParam(Query, I, ATableName)
      else
      begin
        SetUIBParameterValue(field.FieldType, Query, I, v);
      end;
      inc(I);
    end;
    GetLogger.Debug('EXECUTING PREPARED :' + string(SQL));
    FB.Execute(Query);
  finally
    Query.Free;
  end;
  pk_idx := GetPKMappingIndex(AFieldsMapping);
  TdormUtils.SetProperty(AObject, AFieldsMapping[pk_idx].name, pk_value);
  Result := pk_value;
end;

function TUIBBaseAdapter.InTransaction: Boolean;
begin
  Result := assigned(FCurTransaction);
end;

function TUIBBaseAdapter.IsNullKey(const Value: TValue): Boolean;
begin
  case FKeyType of
    ktInteger:
      Result := Value.AsInt64 = FNullKeyValue.AsInt64;
    ktString:
      Result := Value.AsString = FNullKeyValue.AsString;
    else
      raise EdormException.Create('Unknown key type');
  end;
end;

function TUIBBaseAdapter.GetNullKeyValue: TValue;
begin
  Result := FNullKeyValue;
end;

// function TUIBBaseAdapter.GetSelectSQL(
// Criteria: TdormCriteria; AMappingTable: TMappingTable): string;
// var
// SQL: string;
// CritItem: TdormCriteriaItem;
// I: Integer;
// _fields: TMappingFieldList;
// fm: TMappingField;
// select_fields: string;
// d: TDate;
// dt: TDateTime;
//
// function GetFieldMappingByAttribute(AttributeName: string): TMappingField;
// var
// fm: TMappingField;
// begin
// for fm in _fields do
// if fm.name = AttributeName then
// Exit(fm);
// raise EdormException.CreateFmt('Unknown field attribute %s',
// [AttributeName]);
// end;
//
// begin
// _fields := AMappingTable.Fields;
// select_fields := GetSelectFieldsList(_fields, true);
// if assigned(Criteria) and (Criteria.Count > 0) then
// begin
// SQL := 'SELECT ' + select_fields + ' FROM ' + AMappingTable.TableName +
// ' WHERE ';
// for I := 0 to Criteria.Count - 1 do
// begin
// CritItem := Criteria.GetCriteria(I);
// if I > 0 then
// case CritItem.LogicRelation of
// lrAnd:
// SQL := SQL + ' AND ';
// lrOr:
// SQL := SQL + ' OR ';
// end;
// fm := GetFieldMappingByAttribute(CritItem.Attribute);
// SQL := SQL + fm.FieldName;
// case CritItem.CompareOperator of
// coEqual:
// SQL := SQL + ' = ';
// coGreaterThan:
// SQL := SQL + ' > ';
// coLowerThan:
// SQL := SQL + ' < ';
// coGreaterOrEqual:
// SQL := SQL + ' >= ';
// coLowerOrEqual:
// SQL := SQL + ' <= ';
// coNotEqual:
// SQL := SQL + ' != ';
// coLike:
// SQL := SQL + ' LIKE ';
// end;
//
// if fm.FieldType = 'string' then
// SQL := SQL + '''' + EscapeString
// (CritItem.Value.AsString) + ''''
// else if fm.FieldType = 'uniqueidentifier' then
// SQL := SQL + '''' + EscapeString
// (CritItem.Value.AsString) + ''''
// else if fm.FieldType = 'integer' then
// SQL := SQL + inttostr(CritItem.Value.AsInteger)
// else if fm.FieldType = 'boolean' then
// SQL := SQL + BoolToStr(CritItem.Value.AsBoolean)
// else if fm.FieldType = 'boolean' then
// SQL := SQL + BoolToStr(CritItem.Value.AsBoolean)
// else if fm.FieldType = 'date' then
// begin
// d := CritItem.Value.AsExtended;
// SQL := SQL + '''' + EscapeDate(d) + ''''
// end
// else if (fm.FieldType = 'timestamp') or (fm.FieldType = 'datetime') then
// begin
// dt := CritItem.Value.AsExtended;
// SQL := SQL + '''' + EscapeDateTime(dt) + ''''
// end
// else
// raise EdormException.CreateFmt('Unknown type %s in criteria',
// [fm.FieldType]);
// end;
// end
// else // Criteria is nil or is empty
// SQL := 'SELECT ' + select_fields + ' FROM ' + AMappingTable.TableName + ' ';
// Result := SQL;
// end;

function TUIBBaseAdapter.List(ARttiType: TRttiType; ATableName: string;
  AFieldsMapping: TMappingFieldList;
  AdormSearchCriteria: IdormSearchCriteria): TObjectList<TObject>;
begin
  Result := NewList();
  FillList(Result, ARttiType, ATableName, AFieldsMapping,
    AdormSearchCriteria);
end;

procedure TUIBBaseAdapter.FillList(AList: TObject; ARttiType: TRttiType;
  ATableName: string; AFieldsMapping: TMappingFieldList;
  AdormSearchCriteria: IdormSearchCriteria);
var
  SQL: string;
  cmd: TUIBQuery;
begin
  SQL := AdormSearchCriteria.GetSQL;
  GetLogger.Debug('PREPARING: ' + SQL);
  cmd := FB.Prepare(SQL);
  try
    GetLogger.Debug('EXECUTING PREPARED: ' + SQL);
    cmd.Open;
    while not cmd.Eof do
    begin
      TdormUtils.MethodCall(AList, 'Add',
        [CreateObjectFromUIBQuery(ARttiType, cmd,
        AFieldsMapping)]);
      cmd.Next;
    end;
    cmd.Close;
  finally
    cmd.Free;
  end;
end;

function TUIBBaseAdapter.Load(ARttiType: TRttiType; ATableName: string;
  AFieldsMapping: TMappingFieldList; const Value: TValue): TObject;
var
  pk_idx: Integer;
  pk_attribute_name, pk_field_name, SQL: string;
  cmd: TUIBQuery;
begin
  Result := nil;
  pk_idx := GetPKMappingIndex(AFieldsMapping);
  if pk_idx = -1 then
    raise Exception.Create('Invalid primary key for table ' + ATableName);
  pk_attribute_name := AFieldsMapping[pk_idx].name;
  pk_field_name := AFieldsMapping[pk_idx].FieldName;
  SQL := 'SELECT ' + GetSelectFieldsList(AFieldsMapping, true) + ' FROM ' +
    ATableName + ' WHERE ' + pk_field_name + ' = ?';
  GetLogger.Debug('PREPARING: ' + SQL);
  cmd := FB.Prepare(SQL);
  try
    FillPrimaryKeyParam(cmd, pk_idx, Value);
    GetLogger.Debug('EXECUTING PREPARED: ' + SQL);
    cmd.Open;
    if not cmd.Eof then
      Result := CreateObjectFromUIBQuery(ARttiType, cmd, AFieldsMapping);
  finally
    cmd.Free;
  end;
end;

function TUIBBaseAdapter.LoadObjectFromDBXReader(ARttiType: TRttiType;
  AReader: TUIBQuery; AFieldsMapping: TMappingFieldList;
  AObject: TObject): Boolean;
var
  obj: TObject;
  field: TMappingField;
  v: TValue;
begin
  obj := AObject;
  for field in AFieldsMapping do
  begin
    if CompareText(field.FieldType, 'string') = 0 then
    begin
      v := AReader.Fields.ByNameAsString[field.FieldName];
    end
    else if CompareText(field.FieldType, 'integer') = 0 then
    begin
      v := AReader.Fields.ByNameAsInteger[field.FieldName]
    end
    else if CompareText(field.FieldType, 'date') = 0 then
    begin
      v := AReader.Fields.ByNameAsDateTime[field.FieldName];
    end
    else
      raise Exception.Create('Unknown field type for ' + field.FieldName);
    TdormUtils.SetField(obj, field.name, v);
  end;
  Result := true;
end;

function TUIBBaseAdapter.RawExecute(SQL: string): Int64;
begin
  GetLogger.Warning('RAW EXECUTE: ' + SQL);
  Result := FB.Execute(SQL);
end;

function TUIBBaseAdapter.CreateObjectFromUIBQuery
  (ARttiType: TRttiType; AReader: TUIBQuery;
  AFieldsMapping: TMappingFieldList): TObject;
var
  obj: TObject;
  field: TMappingField;
  v: TValue;
  S: string;
  targetStream: TMemoryStream;
begin
  try
    obj := TdormUtils.CreateObject(ARttiType);
    for field in AFieldsMapping do
    begin
      if CompareText(field.FieldType, 'string') = 0 then
      begin
        v := AReader.Fields.ByNameAsString[field.FieldName];
        S := field.FieldName + ' as string';
      end
      else if CompareText(field.FieldType, 'integer') = 0 then
      begin
        v := AReader.Fields.ByNameAsInteger[field.FieldName];
        S := field.FieldName + ' as integer';
      end
      else if CompareText(field.FieldType, 'date') = 0 then
      begin
        v := trunc(AReader.Fields.ByNameAsDateTime[field.FieldName]);
        S := field.FieldName + ' as date';
      end
      else if CompareText(field.FieldType, 'blob') = 0 then
      begin
        targetStream := nil;
        if not AReader.Fields.ByNameIsNull[field.FieldName] then
        begin
          targetStream := TMemoryStream.Create;
          AReader.Fields.ReadBlob(field.FieldName, targetStream);
          targetStream.Position := 0;
        end;
        S := field.FieldName + ' as blob';
        v := targetStream;
      end
      else if CompareText(field.FieldType, 'decimal') = 0 then
      begin
        v := AReader.Fields.ByNameAsDouble[field.FieldName];
        S := field.FieldName + ' as decimal';
      end
      else if CompareText(field.FieldType, 'boolean') = 0 then
      begin
        v := AReader.Fields.ByNameAsBoolean[field.FieldName];
        S := field.FieldName + ' as boolean';
      end
      else if CompareText(field.FieldType, 'datetime') = 0 then
      begin
        v := AReader.Fields.ByNameAsDateTime[field.FieldName];
        S := field.FieldName + ' as datetime';
      end
      else
        raise Exception.Create('Unknown field type for ' + field.FieldName);
      try
        TdormUtils.SetField(obj, field.name, v);
      except
        on E: Exception do
        begin

          raise EdormException.Create(E.Message + sLineBreak +
            '. Probably cannot write ' + ARttiType.ToString + '.' + S);
        end;
      end;
    end;
  except
    on E: Exception do
    begin

      raise;
    end;
  end;
  Result := obj;
end;

class procedure TUIBBaseAdapter.register;
begin
  //
end;

procedure TUIBBaseAdapter.Rollback;
begin
  if not assigned(FCurTransaction) then
    raise Exception.Create('Transaction is not active');
  FCurTransaction.Rollback;
end;

procedure TUIBBaseAdapter.SetUIBParameterValue(AFieldType: string;
  AStatement: TUIBStatement; ParameterIndex: Integer; AValue: TValue);
var
  sourceStream: TStream;
  str: TBytesStream;
begin
  if CompareText(AFieldType, 'string') = 0 then
  begin
    AStatement.Params.AsString[ParameterIndex] := AValue.AsString;
  end
  else if CompareText(AFieldType, 'decimal') = 0 then
  begin
    AStatement.Params.AsDouble[ParameterIndex] := AValue.AsExtended;
  end
  else if CompareText(AFieldType, 'integer') = 0 then
  begin
    AStatement.Params.AsInt64[ParameterIndex] := AValue.AsInt64;
  end
  else if CompareText(AFieldType, 'boolean') = 0 then
  begin
    AStatement.Params.AsBoolean[ParameterIndex] := AValue.AsBoolean;
  end
  else if CompareText(AFieldType, 'date') = 0 then
  begin
    AStatement.Params.AsDateTime[ParameterIndex] := trunc(AValue.AsExtended);
  end
  else if CompareText(AFieldType, 'datetime') = 0 then
  begin
    AStatement.Params.AsDateTime[ParameterIndex] := AValue.AsExtended;
  end
  else if CompareText(AFieldType, 'blob') = 0 then
  begin
    sourceStream := TStream(AValue.AsObject);
    if sourceStream = nil then
      AStatement.Params.IsNull[ParameterIndex] := true
    else
    begin
      str := TBytesStream.Create;
      try
        sourceStream.Position := 0;
        str.CopyFrom(sourceStream, 0);
        str.Position := 0;
        AStatement.ParamsSetBlob(ParameterIndex, str);
      finally
        str.Free;
      end;
    end;
  end;
end;

// procedure TUIBBaseAdapter.SetDBXValue(AFieldType: string;
// aDBXValue: TDBXWritableValue; AValue: TValue);
//
// var
// str: TBytesStream;
// sourceStream: TStream;
// begin
// if CompareText(AFieldType, 'string') = 0 then
// begin
// aDBXValue.AsString := AValue.AsString;
// end
// else if CompareText(AFieldType, 'integer') = 0 then
// begin
// aDBXValue.AsBcd := IntegerToBcd(AValue.AsInt64);
// end
// else if CompareText(AFieldType, 'date') = 0 then
// begin
// aDBXValue.AsDate := DateTimeToTimeStamp(AValue.AsExtended).Date;
// end
// else if CompareText(AFieldType, 'datetime') = 0 then
// begin
// aDBXValue.AsDateTime := FloatToDateTime(AValue.AsExtended);
// end
// else if CompareText(AFieldType, 'blob') = 0 then
// begin
// sourceStream := TStream(AValue.AsObject);
// if sourceStream = nil then
// aDBXValue.SetNull
// else
// begin
// str := TBytesStream.Create;
// try
// sourceStream.Position := 0;
// str.CopyFrom(sourceStream, sourceStream.Size);
// str.Position := 0;
// aDBXValue.SetStream(str, true);
// aDBXValue.ValueType.ValueTypeFlags :=
// aDBXValue.ValueType.ValueTypeFlags or TDBXValueTypeFlags.ExtendedType;
// except
// str.Free;
// raise;
// end;
// end;
// end
// else if CompareText(AFieldType, 'decimal') = 0 then
// begin
// aDBXValue.AsDouble := AValue.AsExtended;
// end
// else if CompareText(AFieldType, 'boolean') = 0 then
// begin
// if AValue.AsBoolean then
// aDBXValue.AsInt16 := 1
// else
// aDBXValue.AsInt16 := 0;
// end
// else
// raise Exception.Create('Unsupported type ' + inttostr(ord(AValue.Kind)));
//
// end;

procedure TUIBBaseAdapter.SetLogger(ALogger: IdormLogger);
begin
  FLogger := ALogger;
end;

procedure TUIBBaseAdapter.StartTransaction;
begin
  FB.GetConnection; // ensure database connected
  FB.StartTransaction;
end;

{ TFirebirdUIBBaseTableSequence }

function TUIBBaseTableSequence.NewIntegerKey(const Entity: string): UInt64;
begin
  Result := FPersistStrategy.ExecuteAndGetFirst('SELECT GEN_ID(SEQ_' + Entity +
    '_ID, 1) FROM RDB$DATABASE');
end;

function TUIBBaseTableSequence.NewStringKey(const Entity: string): string;
begin
  raise EdormException.Create('String keys not supported');
end;

// class procedure TUIBBaseTableSequence.RegisterClass;
// begin
// // do nothing
// end;

// procedure TFirebirdUIBBaseTableSequence.SetFirebirdConnection
// (const Value: TDBXFactory);
// begin
// FFirebirdConnection := Value;
// end;

procedure TUIBBaseTableSequence.SetPersistStrategy(const PersistentStrategy
  : IdormPersistStrategy);
begin
  FPersistStrategy := PersistentStrategy;
end;

// TUIBBaseAdapter.register;
// TUIBBaseTableSequence.RegisterClass;

// finalization

end.
